home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Toolbox / Visual Basic Toolbox (P.I.E.)(1996).ISO / listbox / lstspy / plistspy.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1994-10-08  |  20.5 KB  |  439 lines

  1. VERSION 2.00
  2. Begin Form frmVBProjectListSpy 
  3.    BackColor       =   &H0080FFFF&
  4.    BorderStyle     =   3  'Fixed Double
  5.    Caption         =   "VB Project List Spy"
  6.    ClientHeight    =   4995
  7.    ClientLeft      =   2565
  8.    ClientTop       =   2265
  9.    ClientWidth     =   6540
  10.    Height          =   5430
  11.    Icon            =   PLISTSPY.FRX:0000
  12.    Left            =   2490
  13.    LinkTopic       =   "Form1"
  14.    MaxButton       =   0   'False
  15.    ScaleHeight     =   4995
  16.    ScaleWidth      =   6540
  17.    Top             =   1905
  18.    Width           =   6690
  19.    Begin CommandButton cmdAbout 
  20.       Caption         =   "A&bout..."
  21.       Height          =   330
  22.       Left            =   4425
  23.       TabIndex        =   13
  24.       Top             =   4110
  25.       Width           =   1665
  26.    End
  27.    Begin CommandButton cmdFindForm 
  28.       BackColor       =   &H0000FFFF&
  29.       Caption         =   "Fin&d next entry containing string above"
  30.       Height          =   330
  31.       Index           =   4
  32.       Left            =   165
  33.       TabIndex        =   8
  34.       Top             =   3480
  35.       Width           =   3495
  36.    End
  37.    Begin TextBox txtFormName 
  38.       Height          =   330
  39.       Index           =   1
  40.       Left            =   165
  41.       TabIndex        =   7
  42.       Top             =   3060
  43.       Width           =   3495
  44.    End
  45.    Begin CommandButton cmdHuh 
  46.       BackColor       =   &H0080FFFF&
  47.       Caption         =   "?"
  48.       Height          =   330
  49.       Left            =   3345
  50.       TabIndex        =   12
  51.       Top             =   465
  52.       Width           =   315
  53.    End
  54.    Begin CommandButton cmdFindForm 
  55.       BackColor       =   &H0080FFFF&
  56.       Caption         =   "F&ind Index of Exact Filename Above"
  57.       Height          =   330
  58.       Index           =   1
  59.       Left            =   165
  60.       TabIndex        =   3
  61.       Top             =   1305
  62.       Width           =   3495
  63.    End
  64.    Begin CommandButton cmdFindForm 
  65.       BackColor       =   &H0080FFFF&
  66.       Caption         =   "Fi&nd and Select Form Above"
  67.       Height          =   330
  68.       Index           =   3
  69.       Left            =   165
  70.       TabIndex        =   5
  71.       Top             =   2145
  72.       Width           =   3495
  73.    End
  74.    Begin CommandButton cmdFindForm 
  75.       BackColor       =   &H0000FFFF&
  76.       Caption         =   "N&ame and Index of Current Selection..."
  77.       Height          =   330
  78.       Index           =   5
  79.       Left            =   165
  80.       TabIndex        =   9
  81.       Top             =   4110
  82.       Width           =   3495
  83.    End
  84.    Begin CommandButton cmdFindForm 
  85.       BackColor       =   &H0080FFFF&
  86.       Caption         =   "&Select Form Above in Project Window"
  87.       Height          =   330
  88.       Index           =   2
  89.       Left            =   165
  90.       TabIndex        =   4
  91.       Top             =   1725
  92.       Width           =   3495
  93.    End
  94.    Begin CommandButton cmdFindForm 
  95.       BackColor       =   &H0000FFFF&
  96.       Caption         =   "&List Files In Project"
  97.       Height          =   330
  98.       Index           =   6
  99.       Left            =   165
  100.       TabIndex        =   10
  101.       Top             =   4530
  102.       Width           =   3495
  103.    End
  104.    Begin CommandButton c3dExit 
  105.       BackColor       =   &H0080FFFF&
  106.       Caption         =   "E&xit"
  107.       Height          =   330
  108.       Left            =   4425
  109.       TabIndex        =   11
  110.       Top             =   4530
  111.       Width           =   1665
  112.    End
  113.    Begin TextBox txtFormName 
  114.       Height          =   330
  115.       Index           =   0
  116.       Left            =   165
  117.       TabIndex        =   1
  118.       Top             =   465
  119.       Width           =   3135
  120.    End
  121.    Begin CommandButton cmdFindForm 
  122.       BackColor       =   &H0080FFFF&
  123.       Caption         =   "&Find Index of Form Prefix Above"
  124.       Default         =   -1  'True
  125.       Height          =   330
  126.       Index           =   0
  127.       Left            =   165
  128.       TabIndex        =   2
  129.       Top             =   885
  130.       Width           =   3495
  131.    End
  132.    Begin Label Label1 
  133.       BackColor       =   &H0080FFFF&
  134.       Caption         =   "En&ter a string to find in the list..."
  135.       Height          =   225
  136.       Index           =   1
  137.       Left            =   165
  138.       TabIndex        =   6
  139.       Top             =   2790
  140.       Width           =   3495
  141.    End
  142.    Begin Label Label1 
  143.       BackColor       =   &H0080FFFF&
  144.       Caption         =   "&Enter a filename prefix to find in the list..."
  145.       Height          =   225
  146.       Index           =   0
  147.       Left            =   165
  148.       TabIndex        =   0
  149.       Top             =   195
  150.       Width           =   3735
  151.    End
  152. 'This project code 
  153. 1994 David Stewart
  154. 'Project demonstrating the use of Windows List Box messages
  155. 'to derive and find FileNamePrefixs and strings in the Visual
  156. 'Basic Project window.
  157.    Option Explicit
  158.    DefInt A-Z
  159.    'Const NORMAL% = 0
  160.    'Const MINIMIZED% = 1
  161.    'Const MAXIMIZED% = 2
  162.    Const WM_USER = &H400
  163.    Const LB_FINDSTRING = (WM_USER + 16)
  164.    Const LB_FINDSTRINGEXACT = (WM_USER + 35)
  165.    Const LB_GETCOUNT = (WM_USER + 12)
  166.    Const LB_GETTEXT = (WM_USER + 10)
  167.    Const LB_GETTEXTLEN = (WM_USER + 11)
  168.    Const LB_SELECTSTRING = (WM_USER + 13)
  169.    Const LB_GETCURSEL = (WM_USER + 9)
  170.    Const LB_SETCURSEL = (WM_USER + 7)
  171.    '  GetWindow() Constants
  172.    Const GW_HWNDFIRST = 0
  173.    Const GW_HWNDLAST = 1
  174.    Const GW_HWNDNEXT = 2
  175.    Const GW_HWNDPREV = 3
  176.    Const GW_OWNER = 4
  177.    Const GW_CHILD = 5
  178.    Declare Function FindWindow Lib "User" (ByVal lpClassName As Any, ByVal lpCaption As Any)
  179.    'Declare Function GetActiveWindow Lib "User" () As Integer
  180.    Declare Function GetNextWindow Lib "User" (ByVal hWnd As Integer, ByVal wFlag As Integer) As Integer
  181.    Declare Function GetWindow Lib "User" (ByVal hWnd As Integer, ByVal wCmd As Integer) As Integer
  182.    'Declare Sub HideCaret Lib "user" (ByVal hWnd As Integer)
  183.    'Declare Function IsIconic Lib "User" (ByVal hWnd As Integer) As Integer
  184.    'Declare Function IsZoomed Lib "User" (ByVal hWnd As Integer)
  185.    'Declare Sub MoveWindow Lib "User" (ByVal hWnd As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal nWidth As Integer, ByVal nHeight As Integer, ByVal bRepaint As Integer)
  186.    Declare Function SendMsgByStr& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam$)
  187.    Declare Function SendMsgByNum& Lib "User" Alias "SendMessage" (ByVal hWnd%, ByVal wMsg%, ByVal wParam%, ByVal lParam&)
  188.    'Declare Sub SetActiveWindow Lib "User" (ByVal hWnd)
  189.    'Declare Function SetWindowPos Lib "User" (ByVal hWnd As Integer, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer)
  190.    'Declare Sub ShowCaret Lib "user" (ByVal hWnd As Integer)
  191.    'Declare Function GetFocus Lib "User" () As Integer
  192.    Dim Msg$, DblSp$
  193. Sub c3dExit_Click ()
  194.    Unload Me
  195.    End
  196. End Sub
  197. Sub cmdAbout_Click ()
  198.    Msg$ = "VB Project Spy List" & Chr(10)
  199.    Msg$ = Msg$ & "Copyright 1994 David Stewart" & DblSp
  200.    Msg$ = Msg$ & "VB Project Spy List demonstrates the "
  201.    Msg$ = Msg$ & "ability of Visual Basic applications "
  202.    Msg$ = Msg$ & "to read the filename contents of the VB "
  203.    Msg$ = Msg$ & "design environment's Project window. "
  204.    Msg$ = Msg$ & "This can be useful for developing VB "
  205.    Msg$ = Msg$ & "add-in tools (which is why I worked up "
  206.    Msg$ = Msg$ & "the method myself)." & DblSp
  207.    Msg$ = Msg$ & "You may use and distribute the code in "
  208.    Msg$ = Msg$ & "this project freely. If you have questions, "
  209.    Msg$ = Msg$ & "suggestions or brainstorms you'd like to "
  210.    Msg$ = Msg$ & "share, write to me on AOL, Doc Yeah; "
  211.    Msg$ = Msg$ & "CompuServe, 72122,03562; or Internet, "
  212.    Msg$ = Msg$ & "docyeah@aol.com or 72122.03562@compuserve.com. "
  213.    Msg$ = Msg$ & DblSp & "Cheers!"
  214.    MsgBox Msg$, 48, "VB Project List Spy"
  215. End Sub
  216. Sub cmdFindForm_Click (Index As Integer)
  217.    Dim Response%
  218.    Dim hPROJECTWnd%, PROJECTListBox%, FrmListPos%
  219.    Dim EntriesCount%, LenEntryText%, CurSelPos%, BufLen%, i%, j%
  220.    Dim IsStringIn%
  221.    Dim FileNamePrefix$, EntryText$, Buf$, Msg$
  222.    Cls   'Clear the form of any printing we've done to it.
  223.    'Get a handle for the Project window. NB: The project
  224.    'window does NOT have to be visible on screen to find it!
  225.    'As long as VB is open, it should be available and manipulable,
  226.    'whether visible or not. PROJECT is the class of the Project
  227.    'window.
  228.    hPROJECTWnd = FindWindow("PROJECT", 0&)
  229.    If hPROJECTWnd <> 0 Then
  230.       'Once we've found it, drill down into it to get
  231.       'a handle for the list box. It's the first child
  232.       'window of the Project window.
  233.       PROJECTListBox = GetWindow(hPROJECTWnd, GW_CHILD)
  234.    Else
  235.       MsgBox "Can't find the project window. Visual Basic must not be running.", 32, "Demo Copyright 1994 David Stewart"
  236.       Exit Sub
  237.    End If
  238.    'Initialize the prefix variable with the contents
  239.    'of the upper text box.
  240.    FileNamePrefix = txtFormName(0).Text
  241.    'Action depending on what button's pressed...
  242.    Select Case Index
  243.       Case 0   'Find Index of Form Above
  244.          If txtFormName(0).Text = "" Then Exit Sub 'Can't do a thing without something to look for.
  245.          'Get the position in the list box of the user-
  246.          'specified string prefix, starting search at
  247.          'list entry index 0.
  248.          FrmListPos = SendMsgByStr(PROJECTListBox, LB_FINDSTRING, 0, FileNamePrefix)
  249.          If FrmListPos >= 0 Then
  250.             'If it's in the list, let the user know.
  251.             MsgBox "The index position in the project list box of the file named above is" & Str(FrmListPos) & ".", 64, "Demo Copyright 1994 David Stewart"
  252.          Else
  253.             'And if not, also alert the user.
  254.             MsgBox "The file entered above is not in the Project window's list box.", 64, "Demo Copyright 1994 David Stewart"
  255.          End If
  256.       Case 1
  257.          If txtFormName(0).Text = "" Then Exit Sub
  258.          'Same as above, LB_FINDSTRING, but LB_FINDSTRINGEXACT looks for exactly the
  259.          'WHOLE string given, no more and no less, not treating it as a prefix.
  260.          FrmListPos = SendMsgByStr(PROJECTListBox, LB_FINDSTRINGEXACT, 0, FileNamePrefix)
  261.          If FrmListPos >= 0 Then
  262.             MsgBox "The index position in the project list box of the file named above is" & Str(FrmListPos) & ".", 64, "Demo Copyright 1994 David Stewart"
  263.          Else
  264.             Msg$ = "Either the FileNamePrefix entered above "
  265.             Msg$ = Msg$ & "does not EXACTLY match a list entry "
  266.             Msg$ = Msg$ & "in the Project window's list box, "
  267.             Msg$ = Msg$ & "or the file is not in the project. This message tests an EXACT "
  268.             Msg$ = Msg$ & "match of FileNamePrefix."
  269.             MsgBox Msg$, 64, "VB Project List Spy"
  270.          End If
  271.       Case 2   'Select Form Above in Project Window
  272.          If txtFormName(0).Text = "" Then Exit Sub
  273.          FrmListPos = SendMsgByStr(PROJECTListBox, LB_SELECTSTRING, 0, FileNamePrefix)
  274.          If FrmListPos < 0 Then MsgBox "The file prefix entered above is not in the Project window's list box, so it cannot be selected.", 64, "Demo Copyright 1994 David Stewart"
  275.       Case 3   'Find and Select Form Above
  276.          'This does essentially the same thing as Case 2, but divides it into two steps.
  277.          If txtFormName(0).Text = "" Then Exit Sub
  278.          'Same as in Case 0...
  279.          FrmListPos = SendMsgByStr(PROJECTListBox, LB_FINDSTRING, 0, FileNamePrefix)
  280.          'If we find it,
  281.          If FrmListPos >= 0 Then
  282.             '...ask user if he wants to select it in the list.
  283.             Response = MsgBox("The prefix entered above has been found in the Project window's list box. Do you want to select the form in the list box?", 36, "Demo Copyright 1994 David Stewart")
  284.             'Possible Response values: 6--YES, 7--NO.
  285.             'If yes, then select it and leave the sub.
  286.             If Response = 6 Then
  287.                i = SendMsgByStr(PROJECTListBox, LB_SETCURSEL, 0, FileNamePrefix)
  288.                Exit Sub
  289.             'If not, get out of the routine.
  290.             ElseIf Response = 7 Then
  291.                Exit Sub
  292.             End If
  293.          Else
  294.             'If the user entered a prefix that's not in any file in the list...
  295.             MsgBox "The file prefix entered above is not in the Project window's list box, so it cannot be selected.", 64, "Demo Copyright 1994 David Stewart"
  296.          End If
  297.       Case 4   'Find Next Entry Containing String Above
  298.          'This starts with the list entry below whatever one is
  299.          'currently selected, and looks for the string in
  300.          'its text box INSIDE the strings of list entries, until
  301.          'it finds the next list entry that contains the
  302.          'search string.
  303.          'First, count the number of entries...
  304.          EntriesCount% = SendMsgByNum(PROJECTListBox, LB_GETCOUNT, 0, 0)
  305.          '...then find out where the cursor is currently.
  306.          CurSelPos = SendMsgByNum(PROJECTListBox, LB_GETCURSEL, 0, 0)
  307.          If CurSelPos = EntriesCount - 1 Then CurSelPos = CurSelPos - 1
  308.          'If there are no items in the list, split.
  309.          If EntriesCount% = 0 Then
  310.             MsgBox "There are no files listed in the Project list box.", 64, "Demo Copyright 1994 David Stewart"
  311.             Exit Sub
  312.          Else
  313.             'Begin the search at the list entry below the
  314.             'current selection, go to last entry. We want this
  315.             'procedure to loop around to the beginning, though,
  316.             'so that we can find the entry if it is ABOVE the
  317.             'currently selected one or in case the currently selected
  318.             'one is the only entry that matches. We'll enter
  319.             'another For loop to do that when we reach
  320.             'the last index value of this one. There may be a more
  321.             'efficient way of doing this, but I couldn't think of it
  322.             'at the time.
  323.             For i = CurSelPos + 1 To (EntriesCount - 1) Step 1
  324.                'Get the length of the text in the current entry.
  325.                LenEntryText = SendMsgByNum(PROJECTListBox, LB_GETTEXTLEN, i, 0)
  326.                'Initialize a string to hold the text.
  327.                Buf = String$(LenEntryText + 1, 0)
  328.                'This will obtain the string, storing it in Buf, and return
  329.                'the length of the string.
  330.                BufLen = SendMsgByStr(PROJECTListBox, LB_GETTEXT, i, Buf)
  331.                'Search the Buf string for the string fragment the user's typed in...
  332.                IsStringIn = InStr(1, Buf, txtFormName(1).Text)
  333.                'If we find it, its starting point will be > 0.
  334.                If IsStringIn > 0 Then
  335.                   'Let use know we've found it.
  336.                   MsgBox "The string fragment '" & txtFormName(1).Text & "' has been found" & Chr(10) & "in index entry" & Str(i) & ", " & Left(Buf, LenEntryText) & ".", 64, "Demo Copyright 1994 David Stewart"
  337.                   'Select the entry.
  338.                   FrmListPos = SendMsgByNum(PROJECTListBox, LB_SETCURSEL, i, 0)
  339.                   Exit For
  340.                Else
  341.                   'If we get to the end of the list without having found our string...
  342.                   If i = (EntriesCount - 1) Then
  343.                      '...start another loop from the top of the list to the position
  344.                      'of the selected item when we started the i loop. This way, we miss
  345.                      'no file as a search subject.
  346.                      For j = 0 To CurSelPos Step 1
  347.                         LenEntryText = SendMsgByNum(PROJECTListBox, LB_GETTEXTLEN, j, 0)
  348.                         Buf = String$(LenEntryText + 1, 0)
  349.                         BufLen = SendMsgByStr(PROJECTListBox, LB_GETTEXT, j, Buf)
  350.                         IsStringIn = InStr(1, Buf, txtFormName(1).Text)
  351.                         If IsStringIn > 0 Then
  352.                            MsgBox "The string fragment '" & txtFormName(1).Text & "' has been found" & Chr(10) & "in index entry" & Str(j) & ", " & Left(Buf, LenEntryText) & ".", 64, "Demo Copyright 1994 David Stewart"
  353.                            FrmListPos = SendMsgByNum(PROJECTListBox, LB_SETCURSEL, j, 0)
  354.                            Exit For
  355.                         End If
  356.                      Next j
  357.                   End If
  358.                End If
  359.             Next i
  360.             'If we didn't find it in ANY part of the list box, let user know.
  361.             If IsStringIn = 0 Then
  362.                MsgBox "The string fragment '" & txtFormName(1).Text & "' has not been found" & Chr(10) & "in the Project window list.", 64, "Demo Copyright 1994 David Stewart"
  363.             End If
  364.          End If
  365.       Case 5   'Name and Index of Current Selection...
  366.          'Get the position currently selected in the list...
  367.          CurSelPos = SendMsgByNum(PROJECTListBox, LB_GETCURSEL, 0, 0)
  368.          'Get its length...
  369.          LenEntryText = SendMsgByNum(PROJECTListBox, LB_GETTEXTLEN, CurSelPos, 0)
  370.          'Buffer for it...
  371.          Buf = String$(LenEntryText + 1, 0)
  372.          'Get the string, store in Buf and length of buffer too...
  373.          BufLen = SendMsgByStr(PROJECTListBox, LB_GETTEXT, CurSelPos, Buf)
  374.          'Pass on information about the listing.
  375.          Msg$ = "The file " & Left(Buf, LenEntryText) & " is currently "
  376.          Msg$ = Msg$ & "selected in the Project window list box. "
  377.          Msg$ = Msg$ & "Its entry index number is" & Str(CurSelPos) & "."
  378.          MsgBox Msg$, 64, "Demo Copyright 1994 David Stewart"
  379.       Case 6  'List Files in Project
  380.          frmVBProjectListSpy.CurrentY = 200
  381.          'Get the number of entries...
  382.          EntriesCount% = SendMsgByNum(PROJECTListBox, LB_GETCOUNT, 0, 0)
  383.          If EntriesCount% = 0 Then
  384.             MsgBox "There are no files listed in the Project list box.", 64, "Demo Copyright 1994 David Stewart"
  385.          Else
  386.             'In general, let user know how many files are in the project.
  387.             If EntriesCount = 1 Then
  388.                MsgBox "There is one file listed in the Project list box.", 64, "Demo Copyright 1994 David Stewart"
  389.             Else
  390.                MsgBox "There are" & Str(EntriesCount) & " files listed in the Project list box.", 64, "Demo Copyright 1994 David Stewart"
  391.             End If
  392.             'Now cycle through them from first to last, getting their text.
  393.             For i = 0 To (EntriesCount - 1) Step 1
  394.                LenEntryText = SendMsgByNum(PROJECTListBox, LB_GETTEXTLEN, i, 0)
  395.                Buf = String$(LenEntryText + 1, 0)
  396.                LenEntryText = SendMsgByStr(PROJECTListBox, LB_GETTEXT, i, Buf)
  397.                'Initialize values for the print starting point.
  398.                frmVBProjectListSpy.CurrentX = 4300: frmVBProjectListSpy.CurrentY = frmVBProjectListSpy.CurrentY + 100
  399.                'Print the current index...
  400.                frmVBProjectListSpy.Print Left(Buf, LenEntryText)
  401.             '...and move onto the next until we're done.
  402.             Next i
  403.          'When it's all done, get out.
  404.          End If
  405.    End Select
  406. End Sub
  407. Sub cmdHuh_Click ()
  408.    Msg$ = "A FileNamePrefix prefix is the first n letters of "
  409.    Msg$ = Msg$ & "the form or module FileNamePrefix you want to locate "
  410.    Msg$ = Msg$ & "in the list." & DblSp & "In order for the API function and "
  411.    Msg$ = Msg$ & "message to find the listing, you must begin with "
  412.    Msg$ = Msg$ & "the beginning of the name." & DblSp & "VB can't automatically "
  413.    Msg$ = Msg$ & "find a list entry by letters inside the name, though, "
  414.    Msg$ = Msg$ & "of course, a procedure could be written that would reiteratively "
  415.    Msg$ = Msg$ & "first get a list entry's complete FileNamePrefix text and then "
  416.    Msg$ = Msg$ & "do an InStr search on it. Hey, there's a "
  417.    Msg$ = Msg$ & "button here that does just exactly that! Try it."
  418.    MsgBox Msg$, 64, "Demo Copyright 1994 David Stewart"
  419. End Sub
  420. Sub Form_Load ()
  421.    DblSp = Chr(10) & Chr(10)
  422.    Left = (Screen.Width - Width) / 2: Top = (Screen.Height - Height) / 2
  423. End Sub
  424. Sub txtFormName_GotFocus (Index As Integer)
  425.    'Select all text in box for easy replacement,
  426.    'when user selects either of the the text boxes.
  427.    If Index = 0 Then
  428.       txtFormName(0).SelStart = 0
  429.       txtFormName(0).SelLength = 2500
  430.    Else
  431.       txtFormName(1).SelStart = 0
  432.       txtFormName(1).SelLength = 2500
  433.    End If
  434. End Sub
  435. Sub txtFormName_KeyPress (Index As Integer, KeyASCII As Integer)
  436.    'Convert all typed letter characters to upper case as they're typed in.
  437.    If KeyASCII > 96 And KeyASCII < 123 Then KeyASCII = KeyASCII - 32
  438. End Sub
  439.